#
# Copyright 2008-2010 Vadim Zhukov <persgray@gmail.com>
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice, this
#    list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY AGAVA COMPANY ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
# EVENT SHALL THE AGAVA COMPANY OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# The views and conclusions contained in the software and documentation are
# those of the authors and should not be interpreted as representing official
# policies, either expressed or implied, of the AGAVA Company.

package RB::Remote;

use bytes;
use strict;

use Errno qw/ETIMEDOUT/;
use Exporter qw/import/;
use File::Basename qw/dirname/;
use IO::Handle qw/autoflush/;
use RB::Log;

our @EXPORT = qw/checkAgent openAgentConn generateSeparator/;


# Setting up ssh(1) options
#
# Arguments:
#   $host - host to prepare connecting options for.
#
# Returns:
#   - list with scp command and options
sub prepareSshCmd($) {
	my $host = shift;
	my @sshCmd = qw/ssh -o BatchMode=yes -o RhostsAuthentication=no -T/;
	push(@sshCmd, '-o',
	    'ConnectTimeout='.${main::Config}->{'network_timeout'});
	if (${main::Config}->{'ssh_user'}) {
		push(@sshCmd, '-l', ${main::Config}->{'ssh_user'});
	}
	# Last but not least
	if (${main::Config}->{'ssh_port'}) {
		push(@sshCmd, '-p', ${main::Config}->{'ssh_port'});
	}
	unless (${main::Config}->{'verbosity'} > 0) {
		push(@sshCmd, '-q');
	}
	return (@sshCmd, $host, './rb_agent');
}


# Setting up scp(1) options
#
# Arguments: none
#
# Returns:
#   - list with scp command and options
sub prepareScpCmd() {
	my @scpCmd = qw/scp -o BatchMode=yes -o RhostsAuthentication=no -q/;
	push(@scpCmd, '-o',
	    'ConnectTimeout='.${main::Config}->{'network_timeout'});
	# NOTE: scp(1) forces you to use "user@host" scheme!
	# Last but not least
	if (${main::Config}->{'ssh_port'}) {
		push(@scpCmd, '-P', ${main::Config}->{'ssh_port'});
	}
	unless (${main::Config}->{'verbosity'} > 0) {
		push(@scpCmd, '-q');
	}
	return @scpCmd;
}


# Generate separator when separate_archives being used
#
# Arguments: none
#
# Returns:
#    - pseudorandom string about 80 characters length
sub generateSeparator() {
	return "SEPSTART".rand().rand().rand().rand()."SEPEND";
}


# Pauses program until min_remote_time since last connection elapses.
# Should be called before each connection to remote host.
#
# Arguments: none
#
# Returns: none
my $LastRemoteConnAt = 0;
sub waitMinRemoteTime() {
	my $delta =
	    ($LastRemoteConnAt + ${main::Config}->{'min_remote_time'}) - time();
	if ($delta > 0) {
		logIt(1,
		    "    Waiting $delta seconds between connection requests");
		sleep $delta;
	}
	$LastRemoteConnAt = time();
}


#####################################################################
# Prepare agent
#

# Detect where our agent resides
my $AgentPath;
my $thisPath = dirname $0;
$thisPath = '.' unless $thisPath ne '';
foreach my $p ($thisPath, split(/:/, $ENV{'PATH'})) {
	my $fp = $p.'/rb_agent';
	if (-f $fp and -r $fp and -x $fp) {
		$AgentPath = $fp;
		last;
	}
}
unless (defined $AgentPath) {
	errx(3, "ERROR: cannot find rb_agent");
}

# Dynamically detect our agent version
my $rawAgentVer = `$AgentPath version`;
chomp $rawAgentVer;
$rawAgentVer =~ /version\s+([0-9]+)(\s+|\.)([0-9]+)/i;
my ($majorAgentVer, $minorAgentVer) = ($1, $3);


# Updates agent on a remote host.
#
# Arguments:
#   $host - host to update agent on.
#
# Returns:
#   - boolean (true if updated successfully, false if not)
sub updateAgent($) {
	my $host = shift;
	my $scpDest = $host.':';
	$scpDest = ${main::Config}->{'ssh_user'}.'@'.$scpDest
	    if ${main::Config}->{'ssh_user'};
	my @scpCmd = (prepareScpCmd, $AgentPath, $scpDest);
	print STDERR "AGENT UPDATE CMD: ".join(' ', @scpCmd)."\n"
	    if ${main::Config}->{'test_mode'};
	for (my $i = ${main::Config}->{'max_retry_count'}; $i >= 0; $i--) {
		waitMinRemoteTime;
		if ($i != ${main::Config}->{'max_retry_count'} and
		    ${main::Config}->{'retry_wait'} >
		    ${main::Config}->{'min_remote_time'}) {
			sleep(${main::Config}->{'retry_wait'} -
			    ${main::Config}->{'min_remote_time'});
		}
		if (system(@scpCmd) == 0) {
			logIt(1, "    Agent updated successfully");
			return 2;
		}
	}
	logIt(0, "    Agent update on $host failed with code $?");
	return 0;
}

# Checks agent version on remote host. Updates agent if version is incompatible.
#
# Arguments:
#   $host - host to check/update agent on.
#
# Returns:
#   - boolean (true if checked/updated successfully, false if not)
sub checkAgent($) {
	my $host = shift;
	RB::Log::logIt(1, "    Checking agent version on host $host");

	my @sshCmd = (prepareSshCmd ($host), 'version');
	my $sshCmdPlain = join(' ', @sshCmd);

	waitMinRemoteTime;
	${main::Config}->{'test_mode'}
	    and print STDERR "    SSH COMMAND: $sshCmdPlain\n";
	my $version = `$sshCmdPlain`;
	if ($? != 0) {
		logIt(1, "    Cannot run agent, possibly it doesn't exist");
		return updateAgent ($host);
	} else {
		chomp $version;
		if ($version !~ /version\s+([0-9]+)(\s+|\.)([0-9]+)/i) {
			logIt(1,
			    "    Agent version is unknown, forcing update");
			return updateAgent ($host);
		} else {
			if ($1 != $majorAgentVer or $3 < $minorAgentVer) {
				logIt(1, "    Agent version $1.$3 needs update to $majorAgentVer.$minorAgentVer");
				if ($1 > $majorAgentVer) {
					logIt(0, "    WARNING: downgrading agent version from $1.$3 to $majorAgentVer.$minorAgentVer due to major version part difference");
				}
				return updateAgent($host);
			} else {
				logIt(1, "    Agent is up-to-date ($1.$3)");
			}
		}
	}

	return 1;
}


# Runs agent on a remote host with command specified
#
# Arguments:
#   $host  - host to run agent on
#   $read  - boolean, true if we need to get file handle to read from agent
#   $write - boolean, true if we need to get file handle to write to agent
#
# Returns:
#   - PID of remote process if agent successfully started
#     NB: remember to call waitpid() on it
#   - handle to read from agent (if $read set) or undefined value
#   - handle to write to agent (if $write set) or undefined value
#   * Returns empty list on error
sub openAgentConn($$$;@) {
	my ($host, $read, $write) = (shift, shift, shift);

	my ($readHandle, $childRead, $writeHandle, $childWrite);
	if ($read) {
		unless (pipe($readHandle, $childWrite)) {
			logIt(0, "Cannot open pipe for reading from remote side: $!");
			return;
		}
	}
	if ($write) {
		unless (pipe($childRead, $writeHandle)) {
			logIt(0, "Cannot open pipe for writing to remote side: $!");
			if (defined $readHandle) {
				close $readHandle;
				close $childWrite;
			}
			return;
		}
		$writeHandle->autoflush(1);
	}

	# Do NOT call in child, to keep LastRemoteConnAt actual
	waitMinRemoteTime;

	my $pidSSH = fork;
	unless (defined $pidSSH) {
		logIt(0, "Cannot fork: $!");
		if ($read) {
			close $readHandle;
			close $childWrite;
		}
		if ($write) {
			close $writeHandle;
			close $childRead;
		}
		return;
	}
	if ($pidSSH == 0) {
		# Child: redirect input and output, exec SSH
		# Note: use die() to skip "continue" block
		#  which unlinks files.
		my @sshCmd = prepareSshCmd $host;
		push(@sshCmd, 'verbose') if ${main::Config}->{'test_mode'};
		print STDERR "SSH CMD: ".join(' ', @sshCmd)."\n"
		    if ${main::Config}->{'test_mode'};

		if ($read) {
			close $readHandle;
			open(STDOUT, '>&', $childWrite) or
			    die "CHILD: Cannot dup remote read pipe handle: $!";
			close $childWrite;
		} else {
			open(STDOUT, '>', '/dev/null');
		}
		if ($write) {
			close $writeHandle;
			open(STDIN, '<&', $childRead) or
			    die "CHILD: Cannot dup remote write pipe handle: $!";
			close $childRead;
		} else {
			open(STDIN, '<', '/dev/null');
		}

		${main::Config}->{'test_mode'}
		    and print STDERR
		    "CHILD: Executing: ".join(' ', @sshCmd, @_)."\n";
		exec(@sshCmd, @_);
		# Should not get here of course
		die "CHILD: Cannot execute SSH: $!";
	}
	# Parent
	close $childWrite if $read;
	close $childRead  if $write;

	return ($pidSSH, $readHandle, $writeHandle);
}


1;
